home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 34 / 034.d81 / macro processor (.txt) < prev    next >
Commodore BASIC  |  2022-08-26  |  7KB  |  236 lines
  1. 1 ifag=0thenag=1:load"c64 dir.reader",8,1
  2. 2 dir=49152
  3. 3 :
  4. 5 gosub51000
  5. 10 rem *** macro processor ***
  6. 12 dir=49152
  7. 30 n0$=chr$(0):quote$=chr$(34):true=1:false=0:dim parm$(20)
  8. 40 gt$=chr$(137):gs$=chr$(141)
  9. 50 poke53281,1:poke53280,5:poke646,0
  10. 55 print"[147]  [192][192][192][192][192][192][192] [194][193][211][201][195] [205]acro [208]rocessor[146] [192][192][192][192][192][192]"
  11. 57 print"            by [205]ichael [204]eidel"
  12. 60 print"[197]nter name of host program (source file)";
  13. 62 print"<[208]ress [210][197][212][213][210][206] for a directory>"
  14. 63 print"<[197]nter '[209]' to return to [204][207][193][196][211][212][193][210]>"
  15. 65 gosub61000
  16. 66 ifp$="dir"orp$="[196][201][210]"orp$=""then62000
  17. 67 ifp$="q"orp$="quit"orp$="[209][213][201][212]"then50000
  18. 70 print"[208]rocessing..."p$:print:macro=false:ch=2
  19. 75 li=11:poke1,55:gosub63000
  20. 80 open1,8,15:open2,8,2,"0:"+p$+",p,r":input#1,e,e$:ife=0then100
  21. 90 close2:close1:printe,e$:goto50000
  22. 100 open3,8,3,"0:"+p$+".exp,p,w":input#1,e,e$:ife=0then120
  23. 110 close3:print#1,"s0:"+p$+".exp":input#1,e,e$,e:printe$,e:goto 100
  24. 120 print#3,chr$(1);chr$(8);:gosub240:gosub240
  25. 130 rem **** main processing logic ****
  26. 140 gosub240:d$=c$:gosub240:ifd$=n0$andc$=n0$then460
  27. 150 gosub260:gosub240
  28. 160 if c$="[" thengosub360:l$="":goto140
  29. 170 if c$="!" then if macro then gosub650:goto140
  30. 180 if exclude or c$=quote$ then if macro then gosub1210:goto140
  31. 190 if c$="_" then if macro then gosub1130
  32. 200 if c$=gt$orc$=gs$then if macro then gosub 1480
  33. 210 l$=l$+c$:if c$=n0$ then gosub300:l$="":goto140
  34. 220 gosub240:goto190
  35. 230 rem * closed subroutines follow *
  36. 240 get#ch,c$:ifc$=""thenc$=n0$
  37. 250 return
  38. 260 get#ch,ln$,hn$:ifln$=""thenln$=n0$
  39. 270 if hn$=""thenhn$=n0$
  40. 280 if macro then lm=lm+1:iflm>255thenhm=hm+1:lm=0
  41. 290 return
  42. 300 ifw=0thenw=len(l$)+5:goto320
  43. 310 w=len(l$)+4
  44. 320 wt=wt+w:x=int(wt/256):hp$=chr$(x+8):x=(wt-(x*256)):lp$=chr$(x)
  45. 330 ifmacrothenln$=chr$(lm):hn$=chr$(hm)
  46. 340 print#3,lp$;hp$;ln$;hn$;l$;:return
  47. 350 rem *** open macro file ***
  48. 360 lf$="":l$="":if macro then print"[195]annot nest macros":goto780
  49. 370 gosub240:ifc$<>chr$(34)thenprint#1,"i":print"[205]issing quotes":goto 780
  50. 380 gosub240:ifc$=","then gosub490:print:goto 410
  51. 390 ifc$=quote$ then gosub240:gosub240:goto 410
  52. 400 lf$=lf$+c$:printc$;:goto380
  53. 410 open5,8,5,"0:"+lf$+",p,r":input#1,e,e$:ife=0then 430
  54. 420 print"[147][198]ile error";e;lf$;e$:goto780
  55. 430 macro=true:ch=5:gosub240:gosub240
  56. 440 lm=asc(ln$):hm=asc(hn$):mb=hm*256+lm
  57. 450 l$=chr$(143)+" "+lf$+" macro"+n0$:gosub300:return
  58. 460 if macro then close5:macro=false:ch=2:goto130
  59. 470 print#3,chr$(0);chr$(0);:close2:close3:close1
  60. 480 print"*** [208]rocessing complete ***":print:goto50000
  61. 490 rem collect parameters
  62. 500 for x=1to20:parm$(x)="":nextx:x=1
  63. 510 if x>20 then 580
  64. 520 gosub 240
  65. 530 if c$=n0$thenprint"[147][205]issing quote in macro line":goto780
  66. 540 if c$=quote$then 610
  67. 550 if c$="," then x=x+1:goto 510
  68. 560 parm$(x)=parm$(x)+c$
  69. 570 goto 510
  70. 580 if x>20 then pc=20:goto 610
  71. 590 pc=x
  72. 600 rem 610 checks for closing ] null
  73. 610 gosub240:ifc$<>"]"then630
  74. 620 gosub240:ifc$=n0$ then return
  75. 630 print"[147] [201]nvalid macro syntax":goto780
  76. 640 rem ** handle macro directive **
  77. 650 d1$=""
  78. 660 gosub240
  79. 670 if c$=" "orc$=n0$ then 700
  80. 680 d1$=d1$+c$
  81. 690 goto660
  82. 700 if asc(d1$)=128thenexclude=false:return
  83. 710 if len(d1$)=2 thengosub820:return
  84. 720 if exclude then gosub 1220:return
  85. 730 if d1$="err[176]"then 1240
  86. 740 if d1$="message"thengosub1310:return
  87. 750 if d1$="set"  thengosub1370:return
  88. 760 if d1$="exit" or d1$=chr$(237) then close5:macro=false:ch=2:return
  89. 770 print"[147]invalid macro directive ";d1$:goto780
  90. 780 rem *** abort routine ***
  91. 790 if macro then close5
  92. 800 close2:close3:close1:print"[213]nable to continue at line ";
  93. 810 print(asc(hn$)*256)+asc(ln$):print:goto50000
  94. 820 rem * handle conditional dir *
  95. 830 agnbr=val(d1$)
  96. 840 if agnbr<0 or agnbr>20 then print"[147][201]nvalid argument number ";d1$:goto780
  97. 850 d2$=""
  98. 860 for x=1to3:gosub240:d2$=d2$+c$:next x
  99. 870 gosub240:gosub240
  100. 880 if c$<>quote$ then print"[147][205]issing value quote on !_#":goto780
  101. 890 d3$=""
  102. 900 gosub240:ifc$=n0$thenprint"[147][205]issing quote on !_#":goto780
  103. 910 if c$<>quote$thend3$=d3$+c$:goto900
  104. 920 gosub240:rem get last null
  105. 930 if c$<>n0$ then print"[147]invalid conditional line in macro":goto780
  106. 940 if d2$="eql"then gosub1010:return
  107. 950 if d2$="lss"then gosub1030:return
  108. 960 if d2$="gtr"then gosub1050:return
  109. 970 if d2$="leq"then gosub1070:return
  110. 980 if d2$="neq"then gosub1090:return
  111. 990 if d2$="geq"then gosub1110:return
  112. 1000 print"[147][201]nvalid conditional operator ";d2$:goto780
  113. 1010 if parm$(agnbr)=d3$ then exclude=0:return
  114. 1020 exclude=1:return
  115. 1030 if parm$(agnbr)<d3$ then exclude=0:return
  116. 1040 exclude=1:return
  117. 1050 if parm$(agnbr)>d3$ then exclude=0:return
  118. 1060 exclude=1:return
  119. 1070 if parm$(agnbr)<=d3$ thenexclude=0:return
  120. 1080 exclude=1:return
  121. 1090 if parm$(agnbr)<>d3$ thenexclude=0:return
  122. 1100 exclude=1:return
  123. 1110 if parm$(agnbr)=>d3$ thenexclude=0:return
  124. 1120 exclude=1:return
  125. 1130 rem * handle parameter replacement
  126. 1140 gosub240:d1$=c$:gosub240:d1$=d1$+c$
  127. 1150 agnbr=val(d1$)
  128. 1160 if agnbr<0 or agnbr>20 then print"[147][201]nvalid argument ";d1$:goto 780
  129. 1170 l$=l$+parm$(agnbr)
  130. 1180 gosub 240:rem get byte after [back arrow]arg
  131. 1190 return
  132. 1200 rem * handle macro comment *
  133. 1210 gosub 240
  134. 1220 if c$<>n0$ then 1210
  135. 1230 return
  136. 1240 rem * handle error abort *
  137. 1250 e$="":gosub240:rem read quote
  138. 1260 gosub240:ifc$=quote$then1290
  139. 1270 ifc$=n0$then1300
  140. 1280 e$=e$+c$:goto1260
  141. 1290 gosub240:rem read null
  142. 1300 print"[147]";e$:goto 780
  143. 1310 rem * handle warning msg *
  144. 1320 print"[205]> ";
  145. 1330 gosub240:rem get quote
  146. 1340 gosub240:ifc$=quote$thengosub240:print:return
  147. 1350 if c$=n0$ then print:return
  148. 1360 print c$;:goto 1340
  149. 1370 rem * handle set directive *
  150. 1380 gosub240:d2$=c$:gosub240:d2$=d2$+c$
  151. 1390 argnbr=val(d2$)
  152. 1400 ifargnbr<1orargnbr>20thenprint"[147][201]nvalid argument number ";d2$:goto780
  153. 1410 gosub240:gosub240
  154. 1415 ifc$<>quote$thenprint"[147][205]issing quote on !set":goto780
  155. 1420 d3$=""
  156. 1430 gosub240:ifc$=n0$thenprint"[147][205]issing quote on !set":goto780
  157. 1440 ifc$<>quote$thend3$=d3$+c$:goto1430
  158. 1450 gosub240:rem get last null
  159. 1460 parm$(argnbr)=d3$
  160. 1470 return
  161. 1480 rem handle macro branch
  162. 1490 b$="":l$=l$+c$
  163. 1500 gosub240:ifc$=" "then1500
  164. 1510 ifc$="#"then gosub 240:return
  165. 1520 b$=b$+c$:gosub240
  166. 1530 ifc$=":"orc$=n0$orc$=","then1550
  167. 1540 goto1520
  168. 1550 bo=val(b$):b$=str$(mb+bo)
  169. 1560 ifc$=n0$orc$=":"thenl$=l$+b$:return
  170. 1570 l$=l$+b$+c$:b$="":gosub240:goto1530
  171. 5000 :
  172. 50000 rem  error or done
  173. 50005 print
  174. 50010 print"   [208]ress [[210][197][212][213][210][206]] to compile another"
  175. 50012 printspc(17)"-or-"
  176. 50014 print"  [208]ress [[211][208][193][195][197]] to return to [204][207][193][196][211][212][193][210]."
  177. 50020 poke198,0:wait198,1:geta$
  178. 50030 ifa$=chr$(13)thenrun10
  179. 50040 ifa$=chr$(32)then60000
  180. 50050 goto50020
  181. 50060 :
  182. 51000 print"[147][144][176][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][174]";
  183. 51005 fora=1to23:print"[221]"spc(38)"[221]";:next
  184. 51010 print"[173][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192]":poke53281,1
  185. 51015 poke2023,125:poke2023+54272,.
  186. 51020 print"[204][207][193][196][211][212][193][210] [208]resents:"
  187. 51030 print"[194]asic [205]acro [208]rocessor"
  188. 51040 print"by [205]ichael [204]eidel"
  189. 51045 print"(c) [195]opyright 1987"
  190. 51050 print"[144][208]ress any key to continue."
  191. 51060 poke198,.:wait 198,1:geta$
  192. 51070 return
  193. 59999 stop
  194. 60000 print
  195. 60001 print"     [193]re you sure you want to quit"
  196. 60002 print"        and return to [204][207][193][196][211][212][193][210]?"
  197. 60004 poke198,0:wait198,1:geta$
  198. 60006 ifa$="n"ora$="[206]"then50000
  199. 60008 ifa$="y"ora$="[217]"then60010
  200. 60009 goto60004
  201. 60010 poke1,55
  202. 60020 open15,8,15,"r0:hello connect=hello connect":input#15,er:close15
  203. 60030 ifer<>63thenend
  204. 60040 load "hello connect",8
  205. 60050 :